home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / USERED.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-18  |  15.8 KB  |  627 lines
  1. Uses Dos,Crt,subs1,scrnunit,gentypes,gensubs;
  2.  
  3. const  colorstr:array [0..15] of string[20]=
  4.   ('Black  ','Blue ','Green','Cyan ','Red    ','Magenta','Brown   ','White',
  5.    'Gray  ','BLUE!  ','GREEN!','CYAN!  ','RED!     ','MAGENTA!','Yellow   ','WHITE!');
  6.  
  7.  
  8.  Var
  9.     Infile         :File of Userrec;
  10.     UserRecs       :Userrec;
  11.     Place,a,b,c,d,e:Integer;
  12.     Flag           :boolean;
  13.     Choice         :Char;
  14.     Counter        :Integer;
  15.     UserNum        :Integer;
  16.  
  17. procedure write_rec;forward;
  18. procedure format_data_area;forward;
  19. procedure list_rec;forward;
  20.  
  21. Procedure Show_Fields;
  22. Begin
  23. setColor(9);
  24.   Gotoxy(2,2);Write('Handle');
  25.   Gotoxy(2,3);Write('User Note');
  26.   Gotoxy(2,4);Write('Password');
  27.   Gotoxy(2,5);Write('Main Level');
  28.   Gotoxy(2,6);Write('File Level');
  29.   Gotoxy(2,7);Write('Phone Number');
  30.   Gotoxy(2,8);Write('Real Name');
  31.   Gotoxy(2,9);Write('File Points');
  32.   Gotoxy(2,10);Write('Upload K');
  33.   Gotoxy(2,11);Write('Download K');
  34.   Gotoxy(2,12);Write('Uploads');
  35.   Gotoxy(2,13);Write('Downloads');
  36.   Gotoxy(2,14);Write('Gfile Level');
  37.   Gotoxy(2,15);Write('Gfile UL''s');
  38.   Gotoxy(2,16);Write('Gfile DL''s');
  39.   Gotoxy(2,17);Write('Total Time');
  40.   Gotoxy(2,18);Write('PCR');
  41.   gotoxy(2,19);write('U/D Ratio');
  42.   gotoxy(2,20);write('U/D K Ratio');
  43. End;
  44.  
  45. Procedure Place_Cursor;
  46.  Begin
  47.   With Userrecs do
  48.    Begin
  49.    setcolor(15+16);
  50.     Case Place of
  51.     1:begin Gotoxy(2,2);Write('Handle');     end;
  52.     2:begin Gotoxy(2,3);Write('User Note');  end;
  53.     3:begin Gotoxy(2,4);Write('Password');   end;
  54.     4:begin Gotoxy(2,5);Write('Main Level'); end;
  55.     5:begin Gotoxy(2,6);Write('File Level'); end;
  56.     6:begin Gotoxy(2,7);Write('Phone Number');end;
  57.     7:begin Gotoxy(2,8);Write('Real Name');  end;
  58.     8:begin Gotoxy(2,9);Write('File Points'); end;
  59.     9:begin Gotoxy(2,10);Write('Upload K');   end;
  60.    10:begin Gotoxy(2,11);Write('Download K'); end;
  61.    11:begin Gotoxy(2,12);Write('Uploads');    end;
  62.    12:begin Gotoxy(2,13);Write('Downloads');  end;
  63.    13:begin Gotoxy(2,14);Write('Gfile Level');end;
  64.    14:begin Gotoxy(2,15);Write('Gfile UL''s');end;
  65.    15:Begin Gotoxy(2,16);Write('Gfile DL''s');end;
  66.    16:Begin Gotoxy(2,17);Write('Total Time'); end;
  67.    17:Begin Gotoxy(2,18);Write('PCR');end;
  68.    18:begin gotoxy(2,19);write('U/D Ratio');end;
  69.    19:begin gotoxy(2,20);write('U/D K Ratio');end
  70.   End
  71.  End;
  72. setcolor(15);
  73. End;
  74.  
  75. Procedure Read_Cursor;
  76.  Begin
  77.   With Userrecs do
  78.    Begin
  79.     gotoxy(16,1+place);write('                                 ');
  80.     Case Place of
  81.     1:begin setColor(12);Gotoxy(16,2);Readln(Handle);      End;
  82.     2:Begin setColor(12);Gotoxy(16,3);Readln(userNote);        End;
  83.     3:Begin setColor(12);Gotoxy(16,4);Readln(password);    End;
  84.     4:Begin setColor(12);Gotoxy(16,5);Readln(level);       End;
  85.     5:Begin setColor(12);Gotoxy(16,6);Readln(udlevel);     End;
  86.     6:Begin setColor(12);Gotoxy(16,7);Readln(phonenum);    End;
  87.     7:Begin setColor(12);Gotoxy(16,8);Readln(realname);   End;
  88.     8:Begin setColor(12);Gotoxy(16,9);Readln(udpoints);    End;
  89.     9:Begin setColor(12);Gotoxy(16,10);Readln(upkay);        End;
  90.    10:Begin setColor(12);Gotoxy(16,11);Readln(Dnkay);      End;
  91.    11:Begin setColor(12);Gotoxy(16,12);Readln(uploads);    End;
  92.    12:Begin setColor(12);Gotoxy(16,13);Readln(downloads);  End;
  93.    13:Begin setColor(12);Gotoxy(16,14);Readln(glevel);    End;
  94.    14:Begin setColor(12);Gotoxy(16,15);Readln(nup);  End;
  95.    15:Begin setColor(12);Gotoxy(16,16);Readln(ndn);End;
  96.    16:Begin setColor(12);Gotoxy(16,17);Readln(totaltime);  End;
  97.    17:Begin setColor(12);Gotoxy(16,18);Readln(pcratio);     End;
  98.    18:begin setcolor(12);gotoxy(16,19);readln(udratio);end;
  99.    19:begin setcolor(12);gotoxy(16,20);readln(udkratio);end;
  100.   End
  101.  End;
  102.  write_rec;
  103.  format_data_area;
  104.  list_rec;
  105. End;
  106.  
  107.  
  108. Procedure List_Rec;
  109.    Begin
  110.    setColor(4);
  111.     Seek(infile,Usernum);
  112.     Read(Infile,Userrecs);
  113.     Gotoxy(57,18);Write('UserNumber: ',Usernum);
  114.     if usernum<10 then write(' ');
  115.     if usernum<100 then write(' ');
  116.     if usernum<1000 then write(' ');
  117.     With UserRecs do
  118.     Begin
  119.       Gotoxy(16,2);Write(Handle);
  120.       Gotoxy(16,3);Write(userNote);
  121.       Gotoxy(16,4);Write(password);
  122.       Gotoxy(16,5);Write(level);
  123.       Gotoxy(16,6);Write(udlevel);
  124.       Gotoxy(16,7);Write(phonenum);
  125.       Gotoxy(16,8);Write(realname);
  126.       Gotoxy(16,9);Write(udpoints);
  127.       Gotoxy(16,10);Write(upkay);
  128.       Gotoxy(16,11);Write(Dnkay);
  129.       Gotoxy(16,12);Write(uploads);
  130.       Gotoxy(16,13);Write(downloads);
  131.       Gotoxy(16,14);Write(glevel);
  132.       Gotoxy(16,15);Write(nup);
  133.       Gotoxy(16,16);Write(ndn);
  134.       Gotoxy(16,17);Write(totaltime:6:2);
  135.       Gotoxy(16,18);Write(pcratio);
  136.       gotoxy(16,19);write(udratio);
  137.       gotoxy(16,20);write(udkratio);
  138.     End
  139.    End;
  140.  
  141.  
  142. Procedure Open_Rec;
  143.     Begin
  144.       Assign(Infile,'USERS');
  145.       Reset(Infile);
  146.       Counter:=0;
  147.       While not eof (Infile) do Begin
  148.         Read(Infile,userrecs);
  149.         Counter:=Counter+1
  150.       end;
  151.       UserNum:=1
  152.     end;
  153.  
  154.  Procedure Write_Rec;
  155.  Begin
  156.    Seek(Infile,Usernum);
  157.    Write(Infile,UserRecs)
  158.  End;
  159.  
  160. Procedure Format_Data_Area;
  161.     Begin
  162.      For A:=2 to 20 do begin
  163.          GotoXy(16,A);Write('                                   ');
  164.          End;
  165.     Gotoxy(69,15);Write('   ');
  166.     Gotoxy(57,18);Write('            ');
  167.     End;
  168.  
  169. Procedure Delete_Rec;
  170.     Begin
  171.     With Userrecs do
  172.     Begin
  173.      Nbu:=0;
  174.      Handle:='';
  175.      userNote:='';
  176.      Password:='';
  177.      Level:=0;
  178.      Udlevel:=0;
  179.      Phonenum:='';
  180.      TimeToday:=0;
  181.      Udpoints:=0;
  182.      Upkay:=0;
  183.      Dnkay:=0;
  184.      Uploads:=0;
  185.      Downloads:=0;
  186.      Write_Rec;
  187.      List_Rec;
  188.      Glevel:=0;
  189.      nup:=0;
  190.      ndn:=0;
  191.      TotalTime:=0;
  192.      Macro1:=''
  193.   end;
  194.   Write_Rec;
  195.   Format_Data_Area;
  196.   List_Rec
  197.  End;
  198.  
  199.  
  200. Procedure Add_Rec;
  201.    Begin
  202.     Usernum:=Counter;
  203.     Counter:=Counter+1;
  204.     GotoXy(57,18);Write('UserNubmer: ',Usernum);
  205.     With UserRecs do
  206.     Begin
  207.       nbu:=0;
  208.       Gotoxy(16,2);Readln(Handle);
  209.       Gotoxy(16,3);Readln(userNote);
  210.       Gotoxy(16,4);Readln(password);
  211.       Gotoxy(16,5);Readln(level);
  212.       Gotoxy(16,6);Readln(udlevel);
  213.       Gotoxy(16,7);Readln(phonenum);
  214.       Gotoxy(16,8);Readln(realname);
  215.       Gotoxy(16,9);Readln(udpoints);
  216.       Gotoxy(16,10);Readln(upkay);
  217.       Gotoxy(16,11);Readln(Dnkay);
  218.       Gotoxy(16,12);Readln(uploads);
  219.       Gotoxy(16,13);Readln(downloads);
  220.       Gotoxy(16,14);Readln(glevel);
  221.       Gotoxy(16,15);Readln(nup);
  222.       Gotoxy(16,16);Readln(ndn);
  223.       Gotoxy(16,17);Readln(totaltime);
  224.       Gotoxy(16,18);Readln(pcratio);
  225.       gotoxy(16,19);readln(udratio);
  226.       gotoxy(16,20);readln(udkratio);
  227.     End;
  228.     Seek(Infile,usernum);
  229.     Write(Infile,UserRecs)
  230.    End;
  231.  
  232. procedure showitflags;
  233. Begin
  234.   ClrScr;
  235.   A:=0;
  236.   B:=0;
  237.   C:=0;
  238.   d:=0;
  239.   Flag:=False;
  240.   setColor(11);
  241.   Gotoxy(1,1);
  242.   Write('┌────────────┐');
  243.   For A:=2 to 20 do Begin
  244.     Gotoxy(1,a);
  245.     Write('│            │')
  246.   End;
  247.   Gotoxy(1,21);
  248.   Write('└────────────┘');
  249.   setColor(10);
  250.   Gotoxy(15,1);
  251.   Write('┌───────────────────────────────────┐');
  252.   For A:=2 to 20 do Begin
  253.     Gotoxy(15,a);
  254.     Write('│                                   │')
  255.   End;
  256.   Gotoxy(15,21);
  257.   Write('└───────────────────────────────────┘');
  258.   Show_Fields;
  259.   setColor(14);
  260.   Gotoxy(1,22);
  261.   Write('┌');For a:=2 to 79 do Begin
  262.      Write('─')
  263.   End;
  264.   Gotoxy(80,22);
  265.   Write('┐');
  266.   setColor(12);
  267.   Write('    [Q] Quit            [PageUp] Next User          [PageDown] Previous User');
  268.   setColor(14);
  269.   Gotoxy(1,23);
  270.   Write('│');
  271.   Gotoxy(80,23);
  272.   Write('│');
  273.   Gotoxy(1,24);
  274.   Write('└');
  275.   For a:=2 to 79 do Begin
  276.     Gotoxy(a,24);
  277.     Write('─')
  278.   End;
  279.   Gotoxy(80,24);
  280.   Write('┘');
  281.   setColor(11);
  282.   gotoxy(55,1);
  283.   Write('┌─────────────────┐');
  284.   For A:=2 to 10 do Begin
  285.     Gotoxy(55,a);
  286.     Write('│                 │')
  287.   End;
  288.   Gotoxy(55,10);
  289.   Write('└─────────────────┘');
  290.   setColor(10);
  291.   Gotoxy(57,2);
  292.   Write('ViZ User Editor');
  293.   Gotoxy(57,3);
  294.   Write('Written by the');
  295.   Gotoxy(57,4);
  296.   Write('  ViZ Staff');
  297.   Gotoxy(57,6);
  298.   Write('    v1.00 ');
  299.   setColor(13);
  300.   Gotoxy(55,11);
  301.   Write('┌──────────────────┐');
  302.   For A:=12 to 21 do Begin
  303.     Gotoxy(55,a);
  304.     Write('│                  │')
  305.   End;
  306.   Gotoxy(55,21);
  307.   Write('└──────────────────┘');
  308.   setColor(8);
  309.   Gotoxy(57,12);
  310.   Write('[A] Add User');
  311.   Gotoxy(57,13);
  312.   Write('[D] Delete User');
  313.   gotoxy(57,14);
  314.   write('[C] Edit Flags');
  315.   gotoxy(57,15);
  316.   write('[J] Jump to');
  317.   gotoxy(57,16);
  318.   write('[L] List Users');
  319.   gotoxy(57,17);
  320.   write('[P] Edit Colors');
  321.   Gotoxy(57,19);
  322.   Write('[ESC] to Quit');
  323.   gotoxy(57,20);
  324.   write('[S] Search Users');
  325.   end;
  326.  
  327.   procedure conferenceflags;
  328.   var x:integer;
  329.       s:string;
  330.   begin
  331.   repeat
  332.   clrscr;
  333.   setcolor(11);
  334.   writeln('Users Conference Flags are currently set to:');
  335.   writeln;setcolor(15);
  336.   for x:=1 to 20 do if userrecs.confset[x]>0 then write(x,',') else write('0,');
  337.   writeln;
  338.   for x:=21 to 31 do if userrecs.confset[x]>0 then write(x,',') else write('0,');
  339.   if userrecs.confset[32]>0 then writeln('32') else writeln('0');
  340.   setcolor(13);
  341.   writeln;
  342.   write('Conference to change access for or RETURN to quit:');
  343.   readln(s);
  344.   if s<>'' then begin
  345.     x:=valu(s);
  346.     if (x>0) or (x<33) then if userrecs.confset[x]=0 then userrecs.confset[x]:=1 else userrecs.confset[x]:=0;
  347.   end;
  348.   until s='';
  349.   showitflags;
  350.   format_data_area;
  351.   list_rec;
  352.   write_rec;
  353.   end;
  354.  
  355.   procedure search_users;
  356.   var s,s1:string[50];
  357.       ch:char;
  358.       y:string;
  359.       u:userrec;
  360.       x:integer;
  361.       w3:window;
  362.       possib:boolean;
  363.   begin
  364.   openwindow(w3,18,10,55,16,$1f,$1f);
  365.   setcurwindow(w3);
  366.   setcolor($1f);
  367.   gotoxy(2,1);
  368.   write('String to Search for:');
  369.   readln(s);
  370.   if s='' then begin
  371.      closewindow;
  372.      exit;
  373.   end;
  374.   s:=upstring(s);x:=0;
  375.   gotoxy(2,2);writeln('Searching User log...');
  376.  repeat
  377.    inc(x);
  378.    possib:=false;
  379.    seek(infile,x);
  380.    read(infile,u);
  381.    if pos(s,upstring(u.handle))>0 then possib:=true;
  382.    if pos(s,upstring(u.realname))>0 then possib:=true;
  383.    if pos(s,upstring(u.usernote))>0 then possib:=true;
  384.    if pos(s,upstring(u.phonenum))>0 then possib:=true;
  385.    if possib then begin
  386.      gotoxy(2,3);
  387.      writeln('Edit:'+u.handle+' [y/N]?                 ');
  388.      ch:=readkey;
  389.      s1:=ch;
  390.      if not match(s1,'Y') then possib:=false;
  391.    end;
  392.  until possib or (x=counter-1);
  393.  closewindow;
  394.  if possib then usernum:=x;
  395.  showitflags;
  396.  format_data_area;
  397.  list_rec;
  398.  end;
  399.  
  400.   procedure jumpuser;
  401.   var x:integer;
  402.       w3:window;
  403.       s:string;
  404.   begin
  405.   openwindow(w3,12,10,56,12,15*4,15*4);
  406.   setcurwindow(w3);
  407.   setcolor(15*4+3);
  408.   gotoxy(2,1);
  409.   write('User # to jump to [1-',counter-1,']:');
  410.   readln(s);
  411.   if s='' then begin
  412.     closewindow;
  413.     exit;
  414.     end;
  415.   x:=valu(s);
  416.   if (x>0) and (x<counter) then usernum:=x;
  417.   closewindow;
  418.   showitflags;
  419.   format_data_area;
  420.   list_rec;
  421.   end;
  422.  
  423.   procedure list_users;
  424.   var x,ct,a,b:integer;
  425.       u:userrec;
  426.   begin
  427.     ct:=counter div 23;
  428.     if ct*23<counter then ct:=ct+1;
  429.     x:=0;
  430.     for a:=1 to ct do begin
  431.       clrscr;
  432.       setcolor(14);
  433.       for b:=1 to 23 do begin
  434.         inc(x);
  435.         if x<counter then begin
  436.           seek(infile,x);
  437.           read(infile,u);
  438.           if x<10 then write('.');
  439.           if x<100 then write('.');
  440.           if x<1000 then write('.');
  441.           writeln(x,'] .. ',u.handle);
  442.         end;
  443.       end;         setcolor(15);
  444.     write('Press [Return] to continue.');
  445.     readln;
  446.     end;                  setcolor(15);
  447.   writeln('Press [Return] to continue.');
  448.   showitflags;
  449.   format_data_area;
  450.   list_rec;
  451.   end;
  452.  
  453.   procedure exited;
  454.   begin
  455.   clrscr;
  456.   setcolor(15);
  457.   gotoxy(20,10);
  458.   writeln('ViSiON BBS (c) 1990 TL Enterprises');
  459.   gotoxy(17,12);
  460.   writeln('User Editor v1.00 Written by Ken Sallot');
  461.   gotoxy(20,25);
  462.   writeln('Thank you for Using ViSiON!');
  463.   halt;
  464.   end;
  465.  
  466.  
  467.  procedure do_colors;
  468.  
  469.   function doattrib:integer;
  470.   var p:integer;
  471.  
  472.  
  473.     function demo:integer;
  474.       var cnt:integer;
  475.           K:char;
  476.           w3:window;
  477.     begin
  478.          openwindow(w3,18,9,50,14,15,15);
  479.          setcurwindow(w3);
  480.          gotoxy(5,1);
  481.          setcolor(15);
  482.          write('  Color Selection');
  483.          gotoxy(10,3);
  484.          for cnt:=0 to 15 do begin
  485.            setcolor(cnt);
  486.            write('█');
  487.            end;
  488.            cnt:=0;
  489.            repeat
  490.             gotoxy(10+cnt,2);
  491.             setcolor(15);
  492.             write('');
  493.             gotoxy(2,3);setcolor(cnt);
  494.             if cnt=0 then
  495.             begin
  496.             setcolor(16*7); write('Black');
  497.             setcolor(cnt); write('   ');
  498.             end else
  499.             write(colorstr[cnt]);
  500.             k:=bioskey;
  501.             if k=#205 then begin
  502.                gotoxy(cnt+10,2);write(' ');
  503.                cnt:=cnt+1;
  504.                if cnt>15 then cnt:=0;
  505.                end else if k=#203 then begin
  506.                gotoxy(cnt+10,2);write(' ');
  507.                cnt:=cnt-1;
  508.                if cnt<0 then cnt:=15;
  509.                end;
  510.             until (k=#13) or (k=#27);
  511.             if k=#13 then demo:=cnt
  512.              else demo:=0;
  513.       closewindow;
  514.     end;
  515.  
  516.   var cnt,v:integer;
  517.       k:char;
  518.   begin
  519.     v:=demo;
  520.     p:=v;
  521.     doattrib:=p;
  522.   end;
  523.  
  524.   var w3:window;
  525.   s:string;
  526.   ch:char;
  527.   begin
  528.   openwindow(w3,12,10,54,14,15*4,15*4);
  529.   setcurwindow(w3);
  530.   gotoxy(2,1);
  531.   setcolor(15*4+3);
  532.   write('[A] Regular Color    [B] Prompt Color');
  533.   gotoxy(2,2);
  534.   write('[C] Status Color     [D] Input Color');
  535.   gotoxy(2,3);
  536.   write('[E] Blow Up Boarder  [F] Blow Up Inside');
  537.   ch:=bioskey;
  538.   s:=ch;
  539.   ch:=upcase(s[1]);
  540.   closewindow;
  541.   case ch of
  542.      'A':userrecs.regularcolor:=doattrib;
  543.      'B':userrecs.promptcolor:=doattrib;
  544.      'C':userrecs.statcolor:=doattrib;
  545.      'D':userrecs.inputcolor:=doattrib;
  546.      'E':userrecs.blowboard:=doattrib;
  547.      'F':userrecs.blowinside:=doattrib;
  548.   end;
  549.  end;
  550.  
  551.   begin
  552.   showitflags;
  553.   Open_Rec;
  554.   Format_Data_Area;
  555.   List_Rec;
  556.   Place:=1;
  557.   Place_Cursor;
  558.   While Flag=False do Begin
  559.     Choice:=Readkey;
  560.     Choice:=Upcase(Choice);
  561.     Case Choice of
  562.      'C':conferenceflags;
  563.      'A':Begin
  564.            Format_Data_Area;
  565.            Add_Rec
  566.          End;
  567.      'D':Begin
  568.            Gotoxy(57,18);
  569.            Write('Delete User?');
  570.            Choice:=Readkey;
  571.            Choice:=Upcase(Choice);
  572.            If Choice='Y' then delete_rec else Begin
  573.              Gotoxy(57,18);
  574.              Write('             ')
  575.            End
  576.          End;
  577.      'J':jumpuser;
  578.      'P':do_colors;
  579.      'L':List_users;
  580.      'S':search_users;
  581.      'Q':Begin
  582.            Write_Rec;
  583.            Close(Infile);
  584.            ClrScr;
  585.            exited;
  586.          End;
  587.      #27:Begin
  588.            Write_Rec;
  589.            Close(Infile);
  590.            ClrScr;
  591.            exited;
  592.          End;
  593.      #13:Read_Cursor;
  594.      #0:Begin
  595.           Choice:=Readkey;
  596.           Case Choice of
  597.            #73:Begin
  598.                  Write_Rec;
  599.                  Usernum:=Usernum+1;
  600.                  If Usernum>=counter then Usernum:=1;
  601.                  Format_Data_Area;
  602.                  List_Rec
  603.                End;
  604.            #81:Begin
  605.                  Write_Rec;
  606.                  Usernum:=Usernum-1;
  607.                  If Usernum<1 then usernum:=Counter-1;
  608.                  Format_Data_Area;
  609.                  List_Rec
  610.                End;
  611.            #72:Begin
  612.                  Place:=Place-1;
  613.                  if Place<1 then place:=19;
  614.                  Show_Fields;
  615.                  Place_Cursor
  616.                End;
  617.            #80:Begin
  618.                  Place:=Place+1;
  619.                  If Place>19 then place:=1;
  620.                  Show_Fields;
  621.                  Place_Cursor
  622.                End
  623.         End
  624.      End
  625.   End
  626. End;
  627. End.